home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / mac / tclMacTest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  5.3 KB  |  236 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclMacTest.c --
  3.  *
  4.  *    Contains commands for platform specific tests for
  5.  *    the Macintosh platform.
  6.  *
  7.  * Copyright (c) 1996 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclMacTest.c 1.8 97/05/05 14:14:38
  13.  */
  14.  
  15. #define TCL_TEST
  16.  
  17. #include "tclInt.h"
  18. #include "tclMacInt.h"
  19. #include "tclMacPort.h"
  20. #include "Files.h"
  21. #include <Errors.h>
  22. #include <Resources.h>
  23. #include <Script.h>
  24. #include <Strings.h>
  25. #include <FSpCompat.h>
  26.  
  27. /*
  28.  * Forward declarations of procedures defined later in this file:
  29.  */
  30.  
  31. int            TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
  32. static int        DebuggerCmd _ANSI_ARGS_((ClientData dummy,
  33.                 Tcl_Interp *interp, int argc, char **argv));
  34. static int        WriteTextResource _ANSI_ARGS_((ClientData dummy,
  35.                 Tcl_Interp *interp, int argc, char **argv));
  36.                 
  37.  
  38. /*
  39.  *----------------------------------------------------------------------
  40.  *
  41.  * TclplatformtestInit --
  42.  *
  43.  *    Defines commands that test platform specific functionality for
  44.  *    Unix platforms.
  45.  *
  46.  * Results:
  47.  *    A standard Tcl result.
  48.  *
  49.  * Side effects:
  50.  *    Defines new commands.
  51.  *
  52.  *----------------------------------------------------------------------
  53.  */
  54.  
  55. int
  56. TclplatformtestInit(
  57.     Tcl_Interp *interp)        /* Interpreter to add commands to. */
  58. {
  59.     /*
  60.      * Add commands for platform specific tests on MacOS here.
  61.      */
  62.     
  63.     Tcl_CreateCommand(interp, "debugger", DebuggerCmd,
  64.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  65.     Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource,
  66.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  67.  
  68.     return TCL_OK;
  69. }
  70.  
  71. /*
  72.  *----------------------------------------------------------------------
  73.  *
  74.  * DebuggerCmd --
  75.  *
  76.  *    This procedure simply calls the low level debugger.
  77.  *
  78.  * Results:
  79.  *    A standard Tcl result.
  80.  *
  81.  * Side effects:
  82.  *    None.
  83.  *
  84.  *----------------------------------------------------------------------
  85.  */
  86.  
  87. static int
  88. DebuggerCmd(
  89.     ClientData clientData,        /* Not used. */
  90.     Tcl_Interp *interp,            /* Not used. */
  91.     int argc,                /* Not used. */
  92.     char **argv)            /* Not used. */
  93. {
  94.     Debugger();
  95.     return TCL_OK;
  96. }
  97.  
  98. /*
  99.  *----------------------------------------------------------------------
  100.  *
  101.  * WriteTextResource --
  102.  *
  103.  *    This procedure will write a text resource out to the 
  104.  *    application or a given file.  The format for this command is
  105.  *    textwriteresource 
  106.  *
  107.  * Results:
  108.  *    A standard Tcl result.
  109.  *
  110.  * Side effects:
  111.  *    None.
  112.  *
  113.  *----------------------------------------------------------------------
  114.  */
  115.  
  116. static int
  117. WriteTextResource(
  118.     ClientData clientData,        /* Not used. */
  119.     Tcl_Interp *interp,            /* Current interpreter. */
  120.     int argc,                /* Number of arguments. */
  121.     char **argv)            /* Argument strings. */
  122. {
  123.     char *errNum = "wrong # args: ";
  124.     char *errBad = "bad argument: ";
  125.     char *errStr;
  126.     char *fileName = NULL, *rsrcName = NULL;
  127.     char *data = NULL;
  128.     int rsrcID = -1, i;
  129.     short fileRef = -1;
  130.     OSErr err;
  131.     Handle dataHandle;
  132.     Str255 resourceName;
  133.     FSSpec fileSpec;
  134.  
  135.     /*
  136.      * Process the arguments.
  137.      */
  138.     for (i = 1 ; i < argc ; i++) {
  139.     if (!strcmp(argv[i], "-rsrc")) {
  140.         rsrcName = argv[i + 1];
  141.         i++;
  142.     } else if (!strcmp(argv[i], "-rsrcid")) {
  143.         rsrcID = atoi(argv[i + 1]);
  144.         i++;
  145.     } else if (!strcmp(argv[i], "-file")) {
  146.         fileName = argv[i + 1];
  147.         i++;
  148.     } else {
  149.         data = argv[i];
  150.     }
  151.     }
  152.     
  153.     if ((rsrcName == NULL && rsrcID < 0) ||
  154.         (fileName == NULL) || (data == NULL)) {
  155.         errStr = errBad;
  156.         goto sourceFmtErr;
  157.     }
  158.  
  159.     /*
  160.      * Open the resource file.
  161.      */
  162.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  163.     if (!(err == noErr || err == fnfErr)) {
  164.     Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL);
  165.     return TCL_ERROR;
  166.     }
  167.     
  168.     if (err == fnfErr) {
  169.     FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript);
  170.     }
  171.     fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm);
  172.     if (fileRef == -1) {
  173.     Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL);
  174.     return TCL_ERROR;
  175.     }
  176.         
  177.     UseResFile(fileRef);
  178.  
  179.     /*
  180.      * Prepare data needed to create resource.
  181.      */
  182.     if (rsrcID < 0) {
  183.     rsrcID = UniqueID('TEXT');
  184.     }
  185.     
  186.     strcpy((char *) resourceName, rsrcName);
  187.     c2pstr((char *) resourceName);
  188.     
  189.     dataHandle = NewHandle(strlen(data) + 1);
  190.     HLock(dataHandle);
  191.     strcpy(*dataHandle, data);
  192.     HUnlock(dataHandle);
  193.     
  194.     /*
  195.      * Add the resource to the file and close it.
  196.      */
  197.     AddResource(dataHandle, 'TEXT', rsrcID, resourceName);
  198.     UpdateResFile(fileRef);
  199.     CloseResFile(fileRef);
  200.     return TCL_OK;
  201.     
  202.     sourceFmtErr:
  203.     Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"",
  204.         (char *) NULL);
  205.     return TCL_ERROR;
  206. }
  207.  
  208. int
  209. TclMacChmod(
  210.     char *path, 
  211.     int mode)
  212. {
  213.     HParamBlockRec hpb;
  214.     OSErr err;
  215.     
  216.     c2pstr(path);
  217.     hpb.fileParam.ioNamePtr = (unsigned char *) path;
  218.     hpb.fileParam.ioVRefNum = 0;
  219.     hpb.fileParam.ioDirID = 0;
  220.     
  221.     if (mode & 0200) {
  222.         err = PBHRstFLockSync(&hpb);
  223.     } else {
  224.         err = PBHSetFLockSync(&hpb);
  225.     }
  226.     p2cstr((unsigned char *) path);
  227.     
  228.     if (err != noErr) {
  229.         errno = TclMacOSErrorToPosixError(err);
  230.         return -1;
  231.     }
  232.     
  233.     return 0;
  234. }
  235.  
  236.